home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / eulisp / you-075a.lha / you-075a / ngenerics.c < prev    next >
C/C++ Source or Header  |  1992-06-18  |  17KB  |  674 lines
  1. /*
  2.   * New Generic function interface for feel
  3.   *
  4.   */
  5.  
  6.  /*
  7.    functions:
  8.    
  9.    generic_apply (gf, arglist)
  10.    call_method(meth, sig, args)
  11.    set_compute_function(lisp function)
  12.    sundry accessors
  13.    This approach has lots of advantages....
  14.  
  15.    if generic_apply fails, we call the function
  16.    'compute_and_apply_method' which should 
  17.    1) calculate method to apply
  18.    2) stash the method in a cache
  19.    3) call it via call_method
  20.    
  21.    */
  22. /*
  23.   Data structures:
  24.   A table is a cons structure for accessing via a list    
  25.   format: 
  26.  
  27.   fast cache: (last-method-call-sig result)
  28.   slow cache: table of methods, keying (sig+methods)
  29.               --- keep the sig as we don't want to recontruct it.
  30. */
  31.  
  32. #include "defs.h"
  33. #include "structs.h"
  34. #include "funcalls.h"
  35.  
  36. #include "global.h"
  37. #include "error.h"
  38. #include "allocate.h"
  39. #include "ngenerics.h"
  40. #include "bootstrap.h"
  41. #include "class.h"
  42. #include "bvf.h"
  43. #include "modules.h"
  44. #include "symboot.h"
  45. #include "specials.h"
  46. #include "modboot.h"
  47. #include "calls.h"
  48. #include "vectors.h"
  49.  
  50. static LispObject sym_signature;
  51. static LispObject sym_qualifiers;
  52.  
  53. static LispObject sym_lambda_list;
  54. static LispObject sym_method_class;
  55.  
  56. static LispObject method_status_handle;
  57. static LispObject method_args_handle;
  58.  
  59. static LispObject generic_compute_discriminating_function;
  60. static LispObject generic_add_method;
  61.  
  62. static EUFUN_1( Fn_generic_function_p, obj)
  63. {
  64.   return((is_generic(obj) ? lisptrue : nil));
  65. }
  66. EUFUN_CLOSE
  67.  
  68. static EUFUN_1( Fn_methodp, obj)
  69. {
  70.   return((is_method(obj) ? lisptrue : nil));
  71. }
  72. EUFUN_CLOSE
  73.  
  74. /* Time waster functions */
  75.  
  76. LispObject generic_apply_4(LispObject *stacktop, LispObject gf,
  77.                LispObject a1, LispObject a2,
  78.                LispObject a3, LispObject a4)
  79. {
  80.   LispObject *stackbase=stacktop;
  81.   STACK_TMP(a1); STACK_TMP(a2); STACK_TMP(a3); STACK_TMP(a4);
  82.   
  83.   return(generic_apply(stackbase,gf));
  84. }
  85.  
  86. LispObject generic_apply_3(LispObject *stacktop,LispObject gf,
  87.                LispObject a1, LispObject a2, LispObject a3)
  88. {
  89.   LispObject *stackbase=stacktop;
  90.   STACK_TMP(a1); STACK_TMP(a2); STACK_TMP(a3);
  91.   return(generic_apply(stackbase,gf));
  92. }
  93.  
  94. LispObject generic_apply_2(LispObject *stacktop,LispObject gf,LispObject a1, LispObject a2)
  95. {
  96.   LispObject *stackbase=stacktop;
  97.   STACK_TMP(a1); STACK_TMP(a2); 
  98.   return(generic_apply(stackbase,gf));
  99. }
  100.  
  101. LispObject generic_apply_1(LispObject *stacktop, LispObject gf,
  102.                LispObject a1)
  103. {
  104.   LispObject *stackbase=stacktop;
  105.   STACK_TMP(a1); 
  106.   return(generic_apply(stackbase,gf));
  107. }
  108.  
  109.  
  110. LispObject generic_apply(LispObject *stackbase,LispObject gf)
  111. {
  112.   static LispObject compute_and_apply_method(LispObject *);
  113.   static LispObject call_method(LispObject *,int,LispObject);
  114.   LispObject *stacktop, *walker;
  115.   LispObject ptr,args,fastcache;
  116.   int count, nargs,explicit,extras;
  117.   
  118.   if (intval(generic_argtype(gf)) >= 0) {
  119.     explicit = intval(generic_argtype(gf));
  120.     extras = FALSE;
  121.   }
  122.   else {
  123.     explicit = -intval(generic_argtype(gf))-1;
  124.     extras = TRUE;
  125.   }
  126.   nargs=explicit+(extras ? 1 : 0);
  127.  
  128.   stacktop=stackbase+nargs;
  129.   
  130.   /* fast cache first */
  131.   fastcache=(generic_fast_method_cache(gf));
  132.   ptr=CAR(fastcache); /* nb car(nil)==nil */
  133.   /* is there a cache ? */
  134.   if (ptr!=nil)
  135.     {
  136.       /** Method lookup **/
  137.       walker=stackbase;
  138.       count=0;
  139.       while (count<explicit && CAR(ptr)==classof(*(walker)))
  140.     {
  141.       ptr=CDR(ptr);
  142.       walker++;
  143.       count++;
  144.     }
  145.  
  146.       if (count==explicit)
  147.     return(call_method(stackbase,nargs,
  148.                CDR(fastcache)));
  149.  
  150.       /* then the slow cache */
  151.  
  152.       ptr=generic_slow_method_cache(gf);
  153.       walker=stackbase;
  154.       count=0;
  155.  
  156.       while(ptr!=nil && count<explicit)
  157.     {
  158.       if (CAR(CAR(ptr))==classof(*(walker)))
  159.         {            /* move down 1 */
  160.           ptr=CDR(CAR(ptr));
  161.           walker++;
  162.           count++;
  163.         }
  164.       else
  165.         ptr=CDR(ptr);
  166.     }
  167.       
  168.       if (count==explicit)
  169.     {
  170.       generic_fast_method_cache(gf)=ptr;
  171.       
  172.       return(call_method(stackbase,nargs,CDR(ptr)));
  173.     }
  174.       /* not in slow cache */
  175.     }
  176.  
  177.   STACK_TMP(gf);
  178.   /** find Args **/
  179.   args=allocate_n_conses(stacktop,nargs);
  180.   ptr=args;
  181.  
  182.   walker=stackbase;
  183.   count=0;
  184.   while (count<nargs)
  185.     {
  186.       CAR(ptr)= *walker;
  187.       ptr=CDR(ptr);
  188.       ++walker;
  189.       ++count;
  190.     }
  191.   UNSTACK_TMP(gf);
  192.  
  193.   return(EUCALL_2(compute_and_apply_method,gf, args));
  194.   
  195. }    
  196.  
  197. LispObject call_method(LispObject *stackbase, int nargs, LispObject ml)
  198. {
  199.   LispObject mf;
  200.  
  201.   if (!is_method(CAR(ml)))
  202.     CallError(stackbase,"call-method: Not a method\n",nil,NONCONTINUABLE);
  203.  
  204.   mf = method_function(CAR(ml));
  205.  
  206.   if (is_c_function(mf)) {
  207.     return((mf->C_FUNCTION.func)(stackbase));
  208.   }
  209.  
  210.   /* Should we check the arity of the function --- no add method should. */
  211.   if (is_i_function(mf) || is_e_function(mf)) 
  212.     { /* Should I make the env and apply here ? */
  213.       LispObject *walker,*stacktop;
  214.       LispObject args,ret,ptr;
  215.       int count;
  216.       
  217.       stacktop=stackbase+nargs;
  218.  
  219.       STACK_TMP(mf);
  220.       STACK_TMP(CDR(ml));
  221.  
  222.       /* one method list, one arg list */
  223.       args=allocate_n_conses(stacktop,nargs+2); 
  224.       UNSTACK_TMP(ml);  
  225.       CAR(args)=ml;     /* Arg 1: arg list */
  226.       ptr=CDR(args);
  227.       CAR(ptr)=CDR(ptr);  /* Arg 2: Arguments */
  228.       
  229.       ptr=CDR(ptr);
  230.       walker=stackbase;
  231.       count=0;
  232.       
  233.       while (count<nargs)
  234.     {
  235.       CAR(ptr)= *walker;
  236.       ptr=CDR(ptr);
  237.       ++walker;
  238.       ++count;
  239.     }
  240.       
  241.       UNSTACK_TMP(mf);
  242.       stackbase=stacktop;
  243.       EUCALLSET_2(ret,module_mv_apply_1,mf,args);
  244.       return ret;
  245.     }
  246.  
  247. #ifdef BCI
  248.   if (is_b_function(mf))
  249.     return(apply_nary_bytefunction(stackbase,nargs,ml));
  250. #endif
  251.  
  252.   CallError(stackbase,
  253.         "call method: unknown method function class",mf,NONCONTINUABLE);
  254.  
  255.   return(nil);
  256. }
  257.  
  258. /* repeat of last, but with args passed in a list this time... */
  259. static EUFUN_2(call_method_by_list,ml , args)
  260. {
  261.   LispObject mf;
  262.  
  263.   if (!is_method(CAR(ml)))
  264.     CallError(stacktop,"Not a method\n",nil,NONCONTINUABLE);
  265.  
  266.   mf = method_function(CAR(ml));
  267.  
  268.   if (is_i_function(mf) || is_e_function(mf)) {
  269.     LispObject allargs,ret;
  270.  
  271.     STACK_TMP(mf);
  272.     EUCALLSET_2(allargs, Fn_cons,args,args);
  273.     EUCALLSET_2(allargs, Fn_cons,CDR(ml),allargs);
  274.     UNSTACK_TMP(mf);
  275.  
  276.     EUCALLSET_2(ret,module_mv_apply_1,mf,allargs);
  277.     return ret;
  278.   }
  279.  
  280.   if (is_c_function(mf)) 
  281.     {
  282.       LispObject ret;
  283.  
  284.       EUCALLSET_2(ret,module_mv_apply_1,mf,args);
  285.       return ret;
  286.     }
  287.  
  288. #ifdef BCI
  289.   if (is_b_function(mf))
  290.     {    
  291.       LispObject *ptr=stackbase;
  292.       int i=0;
  293.  
  294.       while (is_cons(args))
  295.     {
  296.       *ptr=CAR(args);
  297.       args=CDR(args);
  298.       ptr++;
  299.       i++;
  300.     }
  301.       return(apply_nary_bytefunction(stackbase,i,ml));
  302.     }
  303. #endif
  304.   CallError(stacktop,
  305.             "call method: unknown method function class",mf,NONCONTINUABLE);
  306.  
  307.   return(nil);
  308. }
  309. EUFUN_CLOSE
  310.  
  311. /** accessors and dull stuff **/
  312.  
  313. static EUFUN_1(Fn_generic_slow_method_cache,gf)
  314. {
  315.   return generic_slow_method_cache(gf);
  316. }
  317. EUFUN_CLOSE
  318.  
  319. static EUFUN_1(Fn_generic_fast_method_cache,gf)
  320. {
  321.   return generic_fast_method_cache(gf);
  322. }
  323. EUFUN_CLOSE
  324.  
  325. static EUFUN_2(Fn_generic_slow_method_cache_setter,gf, value)
  326. {
  327.   return generic_slow_method_cache(gf)=value;
  328. }
  329. EUFUN_CLOSE
  330.  
  331. static EUFUN_2(Fn_generic_fast_method_cache_setter,gf, value)
  332. {
  333.   generic_fast_method_cache(gf)=value;
  334.   return nil;
  335. }
  336. EUFUN_CLOSE
  337.  
  338. static EUFUN_1(Fn_generic_name,gf)
  339. {
  340.   if (!is_generic(gf))
  341.     CallError(stacktop,"generic-method-name: Not a generic",gf,NONCONTINUABLE);
  342.  
  343.   return generic_name(gf);
  344. }
  345. EUFUN_CLOSE
  346.  
  347. static EUFUN_1(Fn_generic_method_class,gf)
  348. {
  349.   if (!is_generic(gf))
  350.     CallError(stacktop,"generic-method-class: Not a generic",gf,NONCONTINUABLE);
  351.  
  352.   return generic_method_class(gf);
  353. }
  354. EUFUN_CLOSE
  355.  
  356. static EUFUN_1(Fn_generic_method_table,gf)
  357. {
  358.   if (!is_generic(gf))
  359.     CallError(stacktop,"generic-method-table: Not a generic",gf,NONCONTINUABLE);
  360.  
  361.   return generic_method_table(gf);
  362. }
  363. EUFUN_CLOSE
  364.  
  365. static EUFUN_2(Fn_generic_method_table_setter,gf, value)
  366. {
  367.   return generic_method_table(gf)=value;
  368. }
  369. EUFUN_CLOSE
  370.  
  371. static EUFUN_1(Fn_generic_discriminator,gf)
  372. {
  373.   return generic_discriminator(gf);
  374. }
  375. EUFUN_CLOSE
  376.  
  377. static EUFUN_2(Fn_generic_discriminator_setter,gf, value)
  378. {
  379.   return generic_discriminator(gf)=value;
  380. }
  381. EUFUN_CLOSE
  382.  
  383. /* Method accessors */
  384.  
  385. static EUFUN_1(Fn_method_signature, meth)
  386. {
  387.   return method_signature(meth);
  388. }
  389. EUFUN_CLOSE
  390.  
  391. /***
  392.   ** Callback definition... 
  393.   **/
  394.  
  395. static LispObject Cb_compute_and_apply_method;
  396.  
  397. EUFUN_2(compute_and_apply_method, gf, args)
  398. {
  399.   LispObject xx;
  400.   EUCALLSET_2(xx,Fn_cons,args,nil);
  401.   EUCALLSET_2(xx,Fn_cons,ARG_0(stackbase),xx);
  402.   
  403.   stacktop=stackbase;
  404.   return EUCALL_2(module_mv_apply_1,CAR(Cb_compute_and_apply_method),xx);
  405. }
  406. EUFUN_CLOSE
  407.  
  408. EUFUN_1(Fn_set_compute_fn,val)
  409. {
  410.   CAR(Cb_compute_and_apply_method)=val;
  411.   return nil;
  412. }
  413. EUFUN_CLOSE
  414.  
  415. /***
  416.   ** Initialising objects 
  417.   **
  418.  ***/
  419.  
  420. extern MODULE Module_generics;
  421.  
  422. static 
  423.   EUFUN_2( Md_allocate_instance_Method_Class, c, args)
  424. {
  425.   LispObject ans;
  426.  
  427.   ans = allocate_instance(stacktop,c);
  428.   lval_typeof(ans)=TYPE_METHOD;
  429.   /* note that we don't need to do this... */
  430.   method_qualifier(ans)    = nil;
  431.   method_signature(ans)    = nil;
  432.   method_host(ans)    = nil;
  433.   method_function(ans)     = nil;
  434.   method_fixed(ans)     = nil;
  435.  
  436.   return(ans);
  437. }
  438. EUFUN_CLOSE
  439.  
  440. static EUFUN_2( Md_initialize_instance_Method, m, args)
  441. {
  442.   extern EUDECL(Md_initialize_instance_1);
  443.   LispObject fun,sig;
  444.  
  445.   m = EUCALL_2(Md_initialize_instance_1, m,args);
  446.   ARG_0(stackbase)=m;
  447.   args=ARG_1(stackbase);
  448.   if ((fun = search_keylist(stacktop,args,sym_function)) == unbound)
  449.     CallError(stacktop,"initialize-instance: missing function initarg for method",
  450.           args,NONCONTINUABLE);
  451.   args=ARG_1(stackbase);
  452.   if ((sig = search_keylist(stacktop,args,sym_signature)) == unbound)
  453.     CallError(stacktop,"initialize-instance: missing signature initarg for method",
  454.           args,NONCONTINUABLE);
  455.   m=ARG_0(stackbase);
  456.   method_qualifier(m) = nil;
  457.   method_function(m) = fun;
  458.   method_host(m) = nil;
  459.   method_signature(m) = sig;
  460.  
  461.   return(m);
  462. }
  463. EUFUN_CLOSE
  464.   
  465. static 
  466.   EUFUN_2( Md_allocate_instance_Generic_Class, c, args)
  467. {
  468.   LispObject ans,nlocal;
  469.  
  470.   ans = allocate_instance(stacktop,c);
  471.   lval_typeof(ans)=TYPE_GENERIC;
  472.   STACK_TMP(ans);
  473.   /* set module, nargs */
  474.   generic_home(ARG_2(stackbase)) = (LispObject) nil;
  475.   generic_argtype(ARG_2(stackbase)) = allocate_integer(stacktop,0);
  476.   
  477.   generic_fast_method_cache(ARG_2(stackbase)) = nil;
  478.   generic_slow_method_cache(ARG_2(stackbase)) = nil;
  479.   generic_method_table(ARG_2(stackbase)) = nil;
  480.  
  481.   /* so that GC won't fall over */
  482.   UNSTACK_TMP(ans);
  483.   generic_name(ans) = unbound;
  484.   generic_method_class(ans) = Method;
  485.   generic_discriminator(ans) = nil;
  486.   
  487.   return(ans);
  488. }
  489. EUFUN_CLOSE
  490.  
  491. static EUFUN_2( Md_initialize_instance_Generic, gf, args)
  492. {
  493.   extern EUDECL( Md_initialize_instance_1);
  494.   LispObject name,ll,mc,meths,tmp;
  495.   LispObject walker;
  496.   int code;
  497.  
  498.   gf = EUCALL_2(Md_initialize_instance_1,gf,args);
  499.   ARG_0(stackbase)=gf;
  500.   args=ARG_1(stackbase);
  501.   if ((ll = search_keylist(stacktop,args,sym_lambda_list)) == unbound)
  502.     CallError(stacktop,"initialize-instance: missing lambda-list for generic",
  503.           args,NONCONTINUABLE);
  504.   if ((meths = search_keylist(stacktop,args,sym_methods)) == unbound) meths = nil;
  505.   
  506.   code = 0; walker = ll;
  507.   while (is_cons(walker)) {
  508.     if (!is_symbol(CAR(walker)))
  509.       CallError(stacktop,
  510.         "initialize-instance: bad formal in generic lambda-list",
  511.         ll,NONCONTINUABLE);
  512.     walker = CDR(walker); ++code;
  513.   }
  514.   if (!is_symbol(walker) && walker != nil)
  515.     CallError(stacktop,"initialise-instance: bad generic lambda-list",
  516.           ll,NONCONTINUABLE);
  517.   if (walker != nil) code = -1-code;
  518.  
  519.   STACK_TMP(meths);
  520.   if ((name = search_keylist(stacktop,ARG_1(stackbase),sym_name)) == unbound) name = unbound;
  521.   generic_name(gf) = name;
  522.   generic_argtype(gf) = allocate_integer(stacktop,code);
  523.   gf=ARG_0(stackbase);
  524.   if ((mc = search_keylist(stacktop,ARG_1(stackbase),sym_method_class)) == unbound)
  525.     CallError(stacktop,"initialize-instance: missing method-class for generic",
  526.           ARG_1(stackbase),NONCONTINUABLE);
  527.   generic_method_class(gf) = mc;
  528.   
  529.   tmp= generic_apply_1(stacktop,generic_compute_discriminating_function,gf);
  530.   gf=ARG_0(stackbase);
  531.   generic_discriminator(gf)=tmp;
  532.   /* Install the methods... */
  533.   
  534.   UNSTACK_TMP(meths);
  535.   gf=ARG_0(stackbase);
  536.   walker = meths;
  537.   while (is_cons(walker)) {
  538.     STACK_TMP(CDR(walker));
  539.     generic_apply_2(stacktop,generic_add_method,gf,CAR(walker));
  540.     gf=ARG_0(stackbase);
  541.     UNSTACK_TMP(walker);
  542.   }
  543.   return(gf);
  544. }
  545. EUFUN_CLOSE
  546.  
  547.  
  548. /* Initialisation of the module */
  549.  
  550. #define GENERICS_ENTRIES 21
  551.  
  552. MODULE Module_generics;
  553. LispObject Module_generics_values[GENERICS_ENTRIES];
  554.  
  555. void initialise_generics(LispObject *stacktop)
  556. {
  557.   Cb_compute_and_apply_method=EUCALL_2(Fn_cons,nil,nil);
  558.   add_root(&Cb_compute_and_apply_method);
  559.  
  560.   method_args_handle = get_symbol(stacktop,"***method-args-handle***");
  561.   add_root(&method_args_handle);
  562.   method_status_handle = get_symbol(stacktop,"***method-status-handle***");
  563.   add_root(&method_status_handle);
  564.  
  565.   sym_signature = get_symbol(stacktop,"signature");
  566.   add_root(&sym_signature);
  567.   sym_qualifiers = get_symbol(stacktop,"qualifiers");
  568.   add_root(&sym_qualifiers);
  569.  
  570.   sym_lambda_list = get_symbol(stacktop,"lambda-list");
  571.   add_root(&sym_lambda_list);
  572.   sym_method_class = get_symbol(stacktop,"method-class");
  573.   add_root(&sym_method_class);
  574.  
  575.   open_module(stacktop,
  576.           &Module_generics,
  577.           Module_generics_values,
  578.           "generics",
  579.           GENERICS_ENTRIES);
  580.  
  581.   generic_compute_discriminating_function = 
  582.     make_module_generic(stacktop,"compute-discriminating-function", 1);
  583.   add_root(&generic_compute_discriminating_function);
  584.  
  585.   (void) make_module_function(stacktop,"generic-function-p",Fn_generic_function_p,1);
  586.   (void) make_module_function(stacktop,"methodp",Fn_methodp,1);
  587.  
  588.   /* Randomised accessors */
  589.   (void) make_module_function(stacktop,"generic-slow-method-cache",Fn_generic_slow_method_cache,1);
  590.   (void) make_module_function(stacktop,"generic-fast-method-cache",Fn_generic_fast_method_cache,1);
  591.   (void) make_module_function(stacktop,"generic-method-table",Fn_generic_method_table,1);
  592.   (void) make_module_function(stacktop,"generic-slow-method-cache-setter",
  593.                   Fn_generic_slow_method_cache_setter,2);
  594.   (void) make_module_function(stacktop,"generic-fast-method-cache-setter",
  595.                   Fn_generic_fast_method_cache_setter,2);
  596.   (void) make_module_function(stacktop,"generic-method-table-setter",
  597.                   Fn_generic_method_table_setter,2);
  598.  
  599.   (void) make_module_function(stacktop,"generic-discriminator",Fn_generic_discriminator,1);
  600.   (void) make_module_function(stacktop,"generic-discriminator-setter",
  601.                   Fn_generic_discriminator_setter,2);
  602.  
  603.   (void) make_module_function(stacktop,"generic-name",Fn_generic_name,1);
  604.   (void) make_module_function(stacktop,"generic-function-method-class",Fn_generic_method_class,1);
  605.  
  606.   (void) make_module_function(stacktop,"method-signature",Fn_method_signature,1);
  607.  
  608.   (void) make_module_function(stacktop,"set-compute-and-apply-fn",Fn_set_compute_fn,1);
  609.   (void) make_module_function(stacktop,"call-method-by-list",call_method_by_list,2);
  610.  
  611.   /* add method */
  612.   generic_add_method=make_module_generic(stacktop,"add-method",2);
  613.   add_root(&generic_add_method);
  614.   /* Making the things... */  
  615.   (void) make_module_function(stacktop,"generic_allocate_instance,Method_Class",
  616.                   Md_allocate_instance_Method_Class,2);
  617.   (void) make_module_function(stacktop,"generic_initialize_instance,Method",
  618.                   Md_initialize_instance_Method,2);
  619.  
  620.   (void) make_module_function(stacktop,"generic_allocate_instance,Generic_Class",
  621.                   Md_allocate_instance_Generic_Class,
  622.                   2);
  623.   (void) make_module_function(stacktop,"generic_initialize_instance,Generic",
  624.                   Md_initialize_instance_Generic,2);
  625.  
  626.   close_module();
  627. }
  628.  
  629.  
  630.  
  631.  
  632. #if 0 /* GENERIC LOOKUP WITH 1st ARG SWITCHING --- case not proven */
  633.       /* then the slow cache */
  634.  
  635. {      tmp=generic_slow_method_cache(gf);
  636.       ptr=tmp;
  637.  
  638.       while(ptr!=nil && CAR(CAR(ptr))!=classof(*stackbase))
  639.     ptr=CDR(ptr);
  640.       
  641.       if (ptr!=nil)
  642.     {
  643.       LispObject tmp2;
  644.  
  645.       tmp2=CAR(tmp);
  646.       CAR(tmp)=CAR(ptr);
  647.       CAR(ptr)=tmp2;
  648.       ptr=CDR(CAR(tmp));
  649.  
  650.       walker=stackbase+1;
  651.       count=1;
  652.       while(ptr!=nil && count<explicit)
  653.         {
  654.           if (CAR(CAR(ptr))==classof(*(walker)))
  655.         {        /* move down 1 */
  656.           ptr=CDR(CAR(ptr));
  657.           walker++;
  658.           count++;
  659.         }
  660.           else
  661.         ptr=CDR(ptr);
  662.         }
  663.       
  664.       if (count==explicit)
  665.         {
  666.           generic_fast_method_cache(gf)=ptr;
  667.  
  668.           return(call_method(stackbase,nargs,CDR(ptr)));
  669.         }
  670.     } 
  671.       /* not in slow cache */
  672.     }
  673. #endif
  674.